home *** CD-ROM | disk | FTP | other *** search
/ Aminet 13 / Aminet 13 - August 1996.iso / Aminet / dev / e / energy.lha / Energy / PD / Hubble.e < prev    next >
Text File  |  1996-05-19  |  12KB  |  460 lines
  1. /*     Hubble V1.1b - 1996 - © Marco Talamelli
  2.     E-Mail: Marco_Talamelli@amp.flashnet.it
  3.      Data:18 May 1996
  4.     A Simple lens
  5. */
  6.  
  7. OPT PREPROCESS
  8. OPT OSVERSION=39
  9.  
  10. MODULE  'intuition/intuition',        -> window
  11.     'intuition/imageclass',
  12.     'intuition/icclass',
  13.     'intuition/screens',        -> screen
  14.     'intuition/gadgetclass',
  15.     'intuition/classes',        -> object
  16.     'exec/ports',            -> MessagePort
  17.     'commodities',
  18.     'libraries/commodities',
  19.     'reqtools',
  20.     'libraries/reqtools',
  21.     'gadtools','iff',
  22.     'libraries/gadtools',
  23.     'graphics/view',
  24.     'graphics/scale',        -> scale image
  25.     'graphics/gfx',            -> bitmap
  26.     'graphics/rastport',
  27.            'other/ecode',
  28.     'devices/inputevent'        -> for inputevent
  29.  
  30. DEF     innerwidth = 200,
  31.     innerheight = 100,
  32.     scalefac = 10,
  33.     cxsigflag, scrdepth,
  34.     waitmask,x,y,
  35.     ie:PTR TO inputevent,
  36.     leftoff, topoff, bottomoff,
  37.     sizeiw, sizeih, winleft=100, wintop=100,
  38.     signal=-1,visualinfo,
  39.     broker_mp=NIL:PTR TO mp,
  40.     broker=NIL,
  41.     userport:PTR TO mp,
  42.     cosignal=NIL,
  43.     mywin:PTR TO window,
  44.     hires,view,
  45.     filereq:PTR TO rtfilerequester,
  46.     filename[34]:STRING,
  47.     scr:PTR TO screen,tmpscr:PTR TO screen,
  48.     sizex, sizey,
  49.     menu:PTR TO menu,task,
  50.     item:PTR TO menuitem,
  51.     srcbm:PTR TO bitmap,
  52.     destbm:PTR TO bitmap,
  53.     scrbm:PTR TO bitmap,
  54.     jump = FALSE, mm = TRUE,
  55.     customcxobj,
  56.     propgadget:PTR TO object,
  57.     pubscreenname[MAXPUBSCREENNAME]:STRING
  58.  
  59. PROC setupscreen()
  60.  
  61.    IF scr
  62.      IF NextPubScreen(scr, pubscreenname)
  63.  
  64.          tmpscr := LockPubScreen(pubscreenname)
  65.             FreeVisualInfo(visualinfo)
  66.             UnlockPubScreen(NIL, scr)
  67.             scr := tmpscr
  68.          ELSE
  69.         RETURN FALSE
  70.         ENDIF
  71.    ELSE
  72.     scr:=LockPubScreen(NIL)
  73.    ENDIF
  74.    visualinfo := GetVisualInfoA(scr, NIL)
  75. ENDPROC TRUE
  76.  
  77. PROC getoffsets()
  78.  
  79. DEF     drawinfo:PTR TO drawinfo,sizeobject
  80.  
  81.    hires := scr.flags
  82.    IF hires THEN (sizeiw := 18) ELSE (sizeiw := 13)
  83.    IF drawinfo := GetScreenDrawInfo(scr)
  84.  
  85.       IF sizeobject := NewObjectA(NIL, 'sysiclass',
  86.                    [SYSIA_WHICH, SIZEIMAGE,
  87.                    SYSIA_DRAWINFO, drawinfo,
  88.                    SYSIA_SIZE,(IF hires THEN SYSISIZE_HIRES ELSE SYSISIZE_MEDRES)])
  89.  
  90.          GetAttr(IA_WIDTH, sizeobject, {sizeiw})
  91.            
  92.          GetAttr(IA_HEIGHT, sizeobject, {sizeih})
  93.  
  94.          DisposeObject(sizeobject)
  95.       ENDIF
  96.       FreeScreenDrawInfo(scr, drawinfo)
  97.    ENDIF
  98.    topoff := scr.rastport.txheight + scr.wbortop + 1
  99.    leftoff := scr.wborleft
  100.    bottomoff := scr.wborbottom
  101.    scrbm := scr.bitmap
  102.    scrdepth := scr.bitmap.depth
  103. ENDPROC
  104.  
  105. PROC allocbm()
  106.  
  107.    IF destbm THEN FreeBitMap(destbm)
  108.    IF srcbm THEN FreeBitMap(srcbm)
  109.    innerwidth := mywin.width - (leftoff + sizeiw)
  110.    innerheight := mywin.height - (topoff + bottomoff)
  111.    sizex:=(innerwidth / scalefac)
  112.    sizey:=(innerheight / scalefac)
  113.  
  114.    srcbm := AllocBitMap(sizex, sizey, scrdepth, BMF_CLEAR, scrbm)
  115.    destbm := AllocBitMap(innerwidth, innerheight, scrdepth, BMF_CLEAR, srcbm)
  116.  
  117. ENDPROC TRUE
  118.  
  119. PROC openwin()
  120.  
  121. DEF resolution,bw,rh,wx,wy
  122.  
  123. wx:=30 + topoff + bottomoff
  124. wy:=60 + leftoff + sizeiw
  125.  
  126.   resolution:= IF scr.flags AND SCREENHIRES THEN SYSISIZE_HIRES ELSE SYSISIZE_LOWRES
  127.  
  128.   bw:=IF resolution=SYSISIZE_LOWRES THEN 1 ELSE 2
  129.   rh:=IF resolution=SYSISIZE_HIRES THEN 2 ELSE 1
  130.  
  131.    IF menu := CreateMenusA([NM_TITLE,0,'Project',0,0,0,0,
  132.     NM_ITEM,0,'Jump','J',0,0,0,
  133.     NM_ITEM,0,NM_BARLABEL,0,0,0,0,
  134.     NM_ITEM,0,'Save Screen','S',0,0,0,
  135.     NM_ITEM,0,NM_BARLABEL,0,0,0,0,
  136.     NM_ITEM,0,'Info Screen','I',0,0,0,
  137.     NM_ITEM,0,NM_BARLABEL,0,0,0,0,
  138.     NM_ITEM,0,'MouseMove','M',(IF mm THEN CHECKED ELSE 0) OR CHECKIT,0,0,
  139.     NM_ITEM,0,NM_BARLABEL,0,0,0,0,
  140.     NM_ITEM,0,'About','A',$0,0,0,
  141.     NM_ITEM,0,NM_BARLABEL,0,0,0,0,
  142.     NM_ITEM,0,'Quit','Q',0,0,0,0]:newmenu,NIL)
  143.  
  144.       IF LayoutMenusA(menu, visualinfo, [GTMN_NEWLOOKMENUS, TRUE, NIL])
  145.  
  146.          IF propgadget := NewObjectA(NIL, 'propgclass',
  147.           [PGA_FREEDOM,    FREEVERT,
  148.           ICA_TARGET,      ICTARGET_IDCMP,
  149.           PGA_NEWLOOK,     TRUE,
  150.           PGA_BORDERLESS,  DRIF_NEWLOOK,
  151.           PGA_TOTAL,       20,
  152.           PGA_VISIBLE,     1,
  153.           PGA_TOP,         scalefac,
  154.           GA_RELVERIFY,    1,
  155.           GA_RELRIGHT,     bw - sizeiw + 3,
  156.           GA_TOP,          topoff + rh,
  157.           GA_WIDTH,        sizeiw - bw - bw - 4,
  158.           GA_RELHEIGHT,    -topoff - sizeih - rh - rh,
  159.           GA_RIGHTBORDER,  TRUE,NIL])
  160.  
  161.             IF mywin := OpenWindowTagList(NIL,
  162.                       [WA_GADGETS,    propgadget,
  163.                        WA_MINWIDTH,    wy,
  164.                        WA_MINHEIGHT,    wx,
  165.                        WA_PUBSCREEN,    scr,
  166.                         WA_TITLE,    'Hubble v1.1b',
  167.                     WA_FLAGS,    WFLG_CLOSEGADGET OR
  168.                     WFLG_SIZEGADGET OR
  169.                     WFLG_SIZEBRIGHT OR
  170.                     WFLG_DRAGBAR OR
  171.                     WFLG_DEPTHGADGET OR
  172.                     WFLG_SIMPLE_REFRESH OR
  173.                     WFLG_ACTIVATE OR
  174.                     WFLG_NEWLOOKMENUS,
  175.                 WA_IDCMP,    IDCMP_CLOSEWINDOW OR
  176.                 IDCMP_NEWSIZE OR
  177.                 IDCMP_MENUPICK OR
  178.                 IDCMP_REFRESHWINDOW OR
  179.                 IDCMP_IDCMPUPDATE,
  180.                             WA_WIDTH,innerwidth + leftoff + sizeiw,
  181.                             WA_HEIGHT,innerheight + topoff + bottomoff,
  182.                              WA_LEFT,        winleft,
  183.                              WA_TOP,         wintop,
  184.                             WA_MAXWIDTH,    -1,
  185.                             WA_MAXHEIGHT,    -1,
  186.                              WA_AUTOADJUST,  TRUE,NIL])
  187.                SetMenuStrip(mywin, menu)
  188.                userport := mywin.userport
  189.                ScreenToFront(scr)
  190.                RETURN TRUE
  191.             ENDIF
  192.          ENDIF
  193.       ENDIF
  194.    ENDIF
  195. ENDPROC FALSE
  196.  
  197. PROC closewin()
  198.  
  199.    IF mywin
  200.     ClearMenuStrip(mywin)
  201.        CloseWindow(mywin)
  202.    ENDIF
  203.    IF menu THEN FreeMenus(menu)
  204.    IF propgadget THEN DisposeObject(propgadget)
  205.    IF srcbm THEN FreeBitMap(srcbm)
  206.    IF destbm THEN FreeBitMap(destbm)
  207.    srcbm := NIL
  208.    destbm := NIL
  209. ENDPROC
  210.  
  211. PROC refresh()
  212. x:= scr.mousex - (sizex / 2)
  213. y:= scr.mousey - (sizey / 2)
  214.  
  215.    IF (x < 0) THEN x := 0
  216.    IF (x > (scr.width - sizex)) THEN x := (scr.width - sizex)
  217.    IF (y < 0) THEN y := 0
  218.  
  219.    IF (y > (scr.height - sizey)) THEN y := (scr.height - sizey)
  220.  
  221.    BltBitMap(scrbm, x, y, srcbm, 0, 0, sizex, sizey, $80 OR $40, -1, NIL)
  222.  
  223.    WaitBlit()
  224.    scale()
  225. ENDPROC
  226.  
  227. PROC scale()
  228.    IF scalefac >1
  229.  
  230.       BitMapScale([0,0,sizex,sizey,1,1,0,0,
  231.         innerwidth,innerheight,scalefac,scalefac,
  232.         srcbm,destbm,0,0,0,0,0]:bitscaleargs)
  233.       WaitBlit()
  234.       BltBitMapRastPort(destbm, 0, 0, mywin.rport, leftoff, topoff, innerwidth, innerheight, $80 OR $40)
  235.  
  236.    ELSE
  237.     BltBitMapRastPort(srcbm, 0, 0, mywin.rport, leftoff, topoff, innerwidth, innerheight, $80 OR $40 )
  238.   ENDIF
  239.    WaitBlit()
  240. ENDPROC
  241.  
  242. PROC processmsg()
  243.  
  244. DEF     intuimsg:PTR TO intuimessage, im,
  245.     msg,
  246.     done = FALSE,
  247.     msgtype, msgid,sigmask, itemNum,    
  248.     code
  249. REPEAT
  250.  
  251.          sigmask := Wait(Shl(1,userport.sigbit) OR Shl(1,signal) OR cxsigflag)
  252.  
  253.       IF (sigmask AND cxsigflag)
  254.          WHILE (msg := GetMsg(broker_mp))
  255.             msgid := CxMsgID(msg)
  256.             msgtype := CxMsgType(msg)
  257.             ReplyMsg(msg)
  258.  
  259.             SELECT msgtype
  260.              CASE CXM_COMMAND
  261.                SELECT msgid
  262.                 CASE CXCMD_DISABLE
  263.                   ActivateCxObj(broker, FALSE)
  264.                 CASE CXCMD_ENABLE
  265.                   ActivateCxObj(broker, TRUE)
  266.                 CASE CXCMD_KILL
  267.                   done := TRUE
  268.                ENDSELECT
  269.             ENDSELECT
  270.          ENDWHILE
  271.       ENDIF
  272.       IF sigmask AND (Shl(1, userport.sigbit))
  273.          jump := FALSE
  274.          WHILE intuimsg := GetMsg(userport)
  275.             ReplyMsg(intuimsg)
  276.         im:=intuimsg.class
  277.             SELECT im
  278.              CASE IDCMP_CLOSEWINDOW
  279.                done := TRUE
  280.              CASE IDCMP_NEWSIZE
  281.                allocbm()
  282.         refresh()
  283.              CASE IDCMP_IDCMPUPDATE
  284.                GetAttr(PGA_TOP, propgadget, {scalefac})
  285.                   INC scalefac
  286.                   allocbm()
  287.             refresh()
  288.              CASE IDCMP_MENUPICK
  289.       code:=intuimsg.code
  290.       WHILE (code<>MENUNULL) AND (jump=FALSE)
  291.         item:=ItemAddress(menu, code)
  292.  
  293.         itemNum:=ITEMNUM(code)
  294.     SELECT itemNum
  295.     CASE 0
  296.      jumpfunc()
  297.     CASE 2
  298.     IF filereq := RtAllocRequestA(RT_FILEREQ, NIL)
  299.         filename[0] := 0
  300.         IF RtFileRequestA(filereq, filename, 'Save as...',0)
  301.  
  302.     view:=(IF scalefac>1 THEN destbm ELSE srcbm)
  303.         IfFL_SaveClip(filename,view,scr.viewport.colormap.colortable,scr.flags,
  304.         0,0,mywin.width/8,mywin.height)
  305.  
  306.         ELSE
  307.         RtEZRequestA('No Save screen!', '_Continue', NIL, NIL,[RT_UNDERSCORE, "_",NIL])
  308.         ENDIF
  309.     RtFreeRequest(filereq)
  310.     ELSE
  311.     RtEZRequestA('No Memory!!', 'Aargh!', NIL, NIL, NIL)
  312.     ENDIF
  313.  
  314.     CASE 4
  315.         RtEZRequestA('Title     : \s\n'+
  316.                 'Width     : \d\n'+
  317.                 'Height    : \d\n'+
  318.                 'Flags     : $\h\n'+
  319.                 'BitMap    : $\h\n'+
  320.                 'Depth     : \d\n',
  321.                     '_Continue',
  322.                         NIL,
  323.                     [scr.title,
  324.                     scr.width,
  325.                     scr.height,
  326.                     scr.flags,
  327.                     scr.bitmap,
  328.                     scr.bitmap.depth],
  329.                     [RT_UNDERSCORE, "_",NIL])
  330.     CASE 6
  331.         IF ((mm = FALSE) AND item.flags)
  332.             mm := TRUE
  333.            ELSEIF ((mm=TRUE) AND item.flags)
  334.             mm := FALSE
  335.         ENDIF
  336.             ActivateCxObj(broker, mm)
  337.     CASE 8
  338.     RtEZRequestA(    'Hubble V1.1b ( 18 May 1996)\n\n'+
  339.                'written by:\n  Marco Talamelli\n'+
  340.                '  Via Massa di San Giuliano 440\n'+
  341.                '  Roma\n  00010\n  ITALIA\n\n'+
  342.                'EMail:\n  Marco_Talamelli@amp.flashnet.it\n\n'+
  343.                'This program is CardWare!\n'+
  344.             'if you like it, send me a postcard of your city!\n'+
  345.             'see you soon!','_Continue',NIL,NIL,[RT_UNDERSCORE, "_",NIL])
  346.     scale()
  347.     CASE 10
  348.      RETURN
  349.     CASE 7
  350.      jump:=TRUE
  351.     ENDSELECT
  352.         code := (item.nextselect) AND ($FFFF)
  353.       ENDWHILE
  354.             ENDSELECT
  355.          ENDWHILE
  356.       ENDIF
  357.       IF sigmask  AND ((ie.class = IECLASS_RAWMOUSE) AND mm) THEN refresh()
  358. UNTIL done
  359. ENDPROC
  360.  
  361. PROC set()
  362.  
  363.       waitmask := waitmask AND (Shl(1,userport.sigbit)+1)
  364.       wintop := mywin.topedge
  365.       winleft := mywin.leftedge
  366.       getoffsets()
  367. ENDPROC
  368.  
  369. PROC jumpfunc()
  370.  
  371. DEF returnvalue
  372.  
  373.    IF returnvalue := setupscreen()
  374.       closewin()
  375.        set()
  376.        WHILE openwin()=FALSE
  377.      RtEZRequestA('Unable to open \a\s\a Screen!','_Continue',NIL,[pubscreenname],[RT_UNDERSCORE, "_",NIL])
  378.      setupscreen()
  379.      set()
  380.     ENDWHILE
  381.       waitmask := waitmask OR Shl(1,userport.sigbit)
  382.        allocbm()
  383.     refresh()
  384.       jump := TRUE
  385.        IF (returnvalue = 1) THEN RETURN TRUE
  386.    ENDIF
  387. ENDPROC FALSE
  388.  
  389. PROC cxfunction(cxm,co)
  390.  
  391.    ie := CxMsgData(cxm)
  392.    IF ((ie.class = IECLASS_RAWMOUSE) AND mm) THEN DivertCxMsg(cxm, co, co)
  393. ENDPROC
  394.  
  395. PROC initbroker()
  396.  
  397. DEF cxfunc
  398.  
  399.    IF broker_mp := CreateMsgPort()
  400.       cxsigflag := Shl(1, broker_mp.sigbit)
  401.  
  402.                signal:=AllocSignal(-1)
  403.           cxsigflag:=Shl(1, signal)
  404.           task:=FindTask(NIL)
  405.           cosignal:=CxSignal(task, signal)
  406.  
  407.       IF broker:=CxBroker(
  408.            [NB_VERSION, 0, 'Hubble',
  409.            'Hubble V1.1b', 'First E Lens!',
  410.             NBU_UNIQUE OR NBU_NOTIFY, 0,
  411.             0,
  412.         0, broker_mp, 0]:newbroker, NIL)
  413.  
  414.              cxfunc := eCodeCxCustom({cxfunction})
  415.          customcxobj:=CxCustom(cxfunc, 0)
  416.  
  417.                  AttachCxObj(broker, customcxobj)
  418.           AttachCxObj(customcxobj, cosignal)
  419.           ActivateCxObj(broker, TRUE)
  420.       ENDIF
  421.    ENDIF
  422. ENDPROC
  423.  
  424. VOID '$VER: Hubble 1.1b (18.05.96) by Marco Talamelli'
  425.  
  426. PROC main()
  427.  
  428. IF reqtoolsbase:=OpenLibrary('reqtools.library',37)
  429.  IF iffbase :=OpenLibrary ('iff.library',21)
  430.    IF cxbase := OpenLibrary ('commodities.library', 37)
  431.  
  432.          IF gadtoolsbase := OpenLibrary ('gadtools.library', 37)
  433.  
  434.             IF setupscreen()
  435.  
  436.                getoffsets()
  437.                wintop := topoff
  438.                IF (scr.height > 300) THEN innerheight:= Shl(innerheight,1)
  439.                IF openwin()
  440.             allocbm()
  441.             refresh()
  442.                       initbroker()
  443.                         processmsg()
  444.              IF broker THEN DeleteCxObjAll(broker)
  445.                 IF signal THEN FreeSignal(signal)
  446.                 IF visualinfo THEN FreeVisualInfo(visualinfo)
  447.                 IF scr THEN UnlockPubScreen(NIL, scr)
  448.                   closewin()
  449.                ENDIF
  450.             ENDIF
  451.             CloseLibrary(gadtoolsbase)
  452.       ENDIF
  453.       CloseLibrary(cxbase)
  454.    ENDIF
  455.   CloseLibrary(iffbase)
  456.  ENDIF
  457.  CloseLibrary(reqtoolsbase)
  458. ENDIF
  459. ENDPROC
  460.